-- Copyright (c) 2007 Maksym Motornyy <mmotorny@gmail.com>
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.

module HPython.Parser where

-- TODO: re-check parsers due to LRM changes

import Data.Complex
import HPython.AbstractSyntaxTree
import HPython.Lexer (LexemeParser)
import HPython.ParserTokens
import HPython.ParsecExtensions
import Text.ParserCombinators.Parsec hiding (notFollowedBy)

literal :: LexemeParser Expression
literal =
	do
	{	do
			_value <- booleanLiteral
			return $ BooleanLiteralExpression _value
	<#>	do
			_value <- integerLiteral
			return $ IntegerLiteralExpression _value
	<#>	do
			_value <- floatingPointLiteral
			return $ FloatingPointLiteralExpression _value
	<#>	do
			_value <- imaginaryLiteral
			return $ ImaginaryLiteralExpression _value
	<#>	do
			_value <- stringLiteral
			return $ StringLiteralExpression _value
	}

-- TODO:
parenthesisForm :: LexemeParser Expression
parenthesisForm =
	do
		delimiter "("
		_elements <- option [] (try expressionList)
		delimiter ")"
		return $
			if length _elements == 1
				then head _elements
				else TupleExpression _elements

-- FIXME:
listDisplay :: LexemeParser Expression
listDisplay =
	do
		delimiter "["
		_expression <- do
			_elements <- option [] (try expressionList)
			return $ ListExpression _elements
		delimiter "]"
		return _expression

-- TODO:
generatorExpression :: LexemeParser Expression
generatorExpression =
	pzero

-- TODO:
dictionaryDisplay :: LexemeParser Expression
dictionaryDisplay =
	pzero

-- TODO:
stringConversion :: LexemeParser Expression
stringConversion =
	pzero
	
enclosure :: LexemeParser Expression
enclosure =
	do
	{	parenthesisForm
	<#>	listDisplay
	<#>	generatorExpression
	<#>	dictionaryDisplay
	<#>	stringConversion
	}

atom :: LexemeParser Expression
atom =
	do
	{	do
			_name <- identifier
			return $ IdentifierExpression _name
	<#>	literal
	<#>	enclosure
	}
	
attributeReference :: Expression -> LexemeParser Expression
attributeReference _object =
	do
		delimiter "."
		_attributeName <- identifier
		return $ AttributeReferenceExpression _object _attributeName
		
subscription :: Expression -> LexemeParser Expression
subscription _object =
	do
		delimiter "["
		_subscript <- expressionList
		delimiter "]"
		return $ SubscriptionExpression _object _subscript
		
-- TODO:
slicing :: Expression -> LexemeParser Expression
slicing _object =
	pzero

call :: Expression -> LexemeParser Expression
call _functor =
	do
		delimiter "("
		-- TODO: argument list
		delimiter ")"
		return $ CallExpression _functor

primary' :: Expression -> LexemeParser Expression
primary' _expression =
	option
		_expression
		(try $ do
			_nextExpression <-
				do
				{	attributeReference _expression
				<#>	subscription _expression
				<#>	slicing _expression
				<#>	call _expression
				}
			primary' _nextExpression
		)
	
primary :: LexemeParser Expression
primary =
	do
		_atom <- atom
		primary' _atom

power :: LexemeParser Expression
power =
	do
		_leftSubexpression <- primary
		option 
			_leftSubexpression
			(try $ do
				operator "**"
				_rightSubexpression <- unaryExpression
				return $ 
					BinaryExpression 
						PowerOperator 
						_leftSubexpression 
						_rightSubexpression
			)

unaryExpression'
	:: LexemeParser UnaryOperator
	-> LexemeParser Expression 
	-> LexemeParser Expression
unaryExpression' _operatorParser _highPrecedenceExpression =
	do
	{	_highPrecedenceExpression
	<#>	do
			_operator <- _operatorParser
			_expression <- 
				unaryExpression' _operatorParser _highPrecedenceExpression
			return $ UnaryExpression _operator _expression
	}

binaryExpression' 
	:: LexemeParser BinaryOperator
	-> LexemeParser Expression 
	-> LexemeParser Expression
binaryExpression' _operatorParser _highPrecedenceExpression =
	do
		_leftSubexpression <- _highPrecedenceExpression
		option 
			_leftSubexpression
			(try $ do
				_operator <- _operatorParser
				_rightSubexpression <- 
					binaryExpression'
						_operatorParser 
						_highPrecedenceExpression
				return $ 
					BinaryExpression 
						_operator 
						_leftSubexpression 
						_rightSubexpression
			)

unaryExpression :: LexemeParser Expression
unaryExpression = 
	unaryExpression'
		(do
		{	do
				operator "-"
				return UnaryMinusOperator
		<#>	do
				operator "+"
				return UnaryPlusOperator
		<#>	do
				operator "~"
				return BitwiseNotOperator
		})
		power

multiplicativeExpression :: LexemeParser Expression
multiplicativeExpression =
	binaryExpression'
		(do
		{	do
				operator "*"
				return MultiplicationOperator
		<#>	do
				operator "/"
				return DivisionOperator
		<#>	do
				operator "//"
				return FloorDivisionOperator
		<#>	do
				operator "%"
				return ModuloOperator
		})
		unaryExpression

additiveExpression :: LexemeParser Expression
additiveExpression =
	binaryExpression'
		(do
		{	do
				operator "+"
				return AdditionOperator
		<#>	do
				operator "-"
				return SubtractionOperator
		})
		multiplicativeExpression

shiftExpression :: LexemeParser Expression
shiftExpression =
	binaryExpression'
		(do
		{	do
				operator "<<"
				return LeftShiftOperator
		<#>	do
				operator ">>"
				return RightShiftOperator
		})
		additiveExpression

andExpression :: LexemeParser Expression
andExpression =
	binaryExpression'
		(do
			operator "&"
			return BitwiseAndOperator
		)
		shiftExpression

xorExpression :: LexemeParser Expression
xorExpression =
	binaryExpression'
		(do
			operator "^"
			return BitwiseXorOperator
		)
		andExpression

orExpression :: LexemeParser Expression
orExpression =
	binaryExpression'
		(do
			operator "|"
			return BitwiseOrOperator
		)
		xorExpression

comparisonOperator :: LexemeParser ComparisonOperator
comparisonOperator =
	do
	{	do 
			operator "<"
			return LessOperator
	<#>	do
			operator ">"
			return GreaterOperator
	<#>	do
			operator "=="
			return EqualOperator
	<#>	do
			operator "!="
			return NotEqualOperator
	<#>	do
			operator "<>"
			return NotEqualOperator
	<#>	do
			operator "<="
			return LessOrEqualOperator
	<#>	do
			operator ">="
			return GreaterOrEqualOperator
	<#>	do
			keyword "is"
			option 
				IsOperator 
				(do 
					keyword "not"
					return IsNotOperator
				)
	<#>	do
			keyword "not"
			keyword "in"
			return NotInOperator
	<#>	do
			keyword "in"
			return InOperator
	}
	
comparison :: LexemeParser Expression
comparison =
	do
		_firstExpression <- orExpression
		_comparisons <- 
			many $ do
				_comparisonOperator <- comparisonOperator
				_expression <- orExpression
				return (_comparisonOperator, _expression)
		return $ 
			if null _comparisons
				then _firstExpression
				else ComparisonExpression _firstExpression _comparisons

notTest :: LexemeParser Expression
notTest =
	unaryExpression'
		(do
			keyword "not"
			return LogicalNotOperator
		)
		comparison

andTest :: LexemeParser Expression
andTest =
	binaryExpression'
		(do
			keyword "and"
			return LogicalAndOperator
		)
		notTest

orTest :: LexemeParser Expression
orTest =
	binaryExpression'
		(do
			keyword "or"
			return LogicalOrOperator
		)
		andTest

test :: LexemeParser Expression
test =
	do
	{	orTest 
	<#>	lambdaForm
	}

sublist :: LexemeParser [Parameter]
sublist =
	parameter `sepEndBy1` (delimiter ",")

parameter :: LexemeParser Parameter
parameter =
	do
	{	do
			_name <- identifier
			return $ IdentifierParameter _name
	<#>	do
			delimiter "("
			_parameters <- sublist
			delimiter ")"
			return $ ListParameter _parameters
	}

defaultParameter :: LexemeParser Parameter
defaultParameter =
	do
		_parameter <- parameter
		option
			_parameter
			(try $ do
				delimiter "="
				_expression <- expression
				return $ DefaultParameter _parameter _expression
			)

parameterList :: LexemeParser ([Parameter], Maybe String, Maybe String)
parameterList =
	do
		_parameters <-
			many $ try $ do
				_parameter <- defaultParameter
				delimiter ","
				return _parameter
		do
		{	do
				operator "*"
				_excessPositionalParameters <-
					do
						_name <- identifier
						return $ Just _name
				_excessKeywordParameters <-
					option 
						Nothing
						(try $ do
							delimiter ","
							operator "**"
							_name <- identifier
							return $ Just _name
						)
				return
					(
					_parameters,
					_excessPositionalParameters,
					_excessKeywordParameters
					)
		<#>	do
				operator "**"
				_name <- identifier
				return (_parameters, Nothing, Just _name)
		<#>	do
				_lastParameter <- defaultParameter
				option () (delimiter ",")
				return (_parameters ++ [_lastParameter], Nothing, Nothing)
		}

lambdaForm :: LexemeParser Expression
lambdaForm =
	do
		keyword "lambda"
		(_parameters, _excessPositionalParameters, _excessKeywordParameters) <-
			option ([], Nothing, Nothing) (try parameterList)
		delimiter ":"
		_expression <- expression
		return $ 
			LambdaExpression 
				_parameters 
				_excessPositionalParameters 
				_excessKeywordParameters 
				_expression

expression :: LexemeParser Expression
expression =
	do
	{	conditionalExpression
	<#>	lambdaForm
	}
		
conditionalExpression :: LexemeParser Expression
conditionalExpression =
	do
		_orTest <- orTest
		do
		{	do
				notFollowedBy $ keyword "if"
				return _orTest
		<#>	do
				keyword "if"
				_condition <- orTest
				keyword "else"
				_elseExpression <- expression
				return $ IfElseExpression _condition _orTest _elseExpression
		}

expressionList :: LexemeParser [Expression]
expressionList =
	expression `sepEndBy1` (delimiter ",")

expressionStatement :: LexemeParser Statement
expressionStatement =
	do
		_expressions <- expressionList
		return $ ExpressionStatement _expressions

makeTarget :: [Target] -> Target
makeTarget _targets =
	if length _targets == 1
		then head _targets
		else TupleTarget _targets

target :: LexemeParser Target
target =
	do
	{	do
			delimiter "("
			_targets <- targetList
			delimiter ")"
			return $ makeTarget _targets
	<#>	do
			delimiter "["
			_targets <- targetList
			delimiter "]"
			return $ ListTarget _targets
	<#>	do
			-- FIXME: primary is wider than l-value
			_expression <- primary
			return $ SingleTarget _expression
	}

targetList :: LexemeParser [Target]
targetList =
	target `sepEndBy1` (delimiter ",")

assignmentStatement :: LexemeParser Statement
assignmentStatement =
	do
		_targets <- 
			many1 $ try $ do
				_targets <- targetList
				delimiter "="
				return $ makeTarget _targets
		_expressions <- expressionList
		return $ AssignmentStatement _targets _expressions

-- FIXME: return type is wrong
augmentedAssignmentOperand :: LexemeParser ()
augmentedAssignmentOperand =
	do
	{	delimiter "+="
	<#>	delimiter "-="
	<#>	delimiter "*="
	<#>	delimiter "/="
	<#>	delimiter "%="
	<#>	delimiter "**="
	<#>	delimiter ">>="
	<#>	delimiter "<<="
	<#>	delimiter "&="
	<#>	delimiter "^="
	<#>	delimiter "|="
	}

printStatementEndOfLine :: LexemeParser Bool
printStatementEndOfLine =
	do
	{	do
			delimiter ","
			return False
	<#>	return True
	}

printStatement :: LexemeParser Statement
printStatement =
	do
		keyword "print"
		do
		{	do
				operator ">>"
				_file <- expression
				_expressions <-
					many1 $ do
						delimiter ","
						expression
				_endOfLine <- printStatementEndOfLine
				return $ PrintStatement (Just _file) _expressions _endOfLine
		<#>	do
				_expressions <- expression `sepBy1` (delimiter ",")
				_endOfLine <- printStatementEndOfLine
				return $ PrintStatement Nothing _expressions _endOfLine
		<#>	do
				return $ PrintStatement Nothing [] True
		}

-- TODO:
simpleStatement :: LexemeParser Statement
simpleStatement =
	do
	{	assignmentStatement
--	<#>	augmentedAssignmentStatement
	<#>	expressionStatement
--	<#>	assertStatement
--	<#>	augmentedAssignmentStatement
--	<#>	passStatement
--	<#>	delStatement
	<#>	printStatement
--	<#>	returnStatement
--	<#>	yieldStatement
--	<#>	raiseStatement
--	<#>	breakStatement
--	<#>	continueStatement
--	<#>	importStatement
--	<#>	globalStatement
--	<#>	execStatement
	}

statementList :: LexemeParser [Statement]
statementList =
	simpleStatement `sepEndBy1` (delimiter ";")

ifStatement :: LexemeParser Statement
ifStatement =
	do
		keyword "if"
		_firstCondition <- expression
		delimiter ":"
		_firstSuite <- suite
		_ifClauses <-
			many $ do
				keyword "elif"
				_condition <- expression
				delimiter ":"
				_suite <- suite
				return (_condition, _suite)
		_elseSuite <-
			do
			{	do
					notFollowedBy $ keyword "else"
					return []
			<#>	do
					keyword "else"
					delimiter ":"
					suite
			}
		return $ 
			IfStatement 
				((_firstCondition, _firstSuite):_ifClauses) 
				_elseSuite

compoundStatement :: LexemeParser Statement
compoundStatement =
	do
	{	ifStatement
-- TODO:
--	<#>	whileStatement
--	<#>	forStatement
--	<#>	tryStatement
--	<#>	withStatement
--	<#>	functionDefinition
--	<#>	classDefinition
	}

statement :: LexemeParser [Statement]
statement =
	do
	{	do
			_statementList <- statementList
			newLine
			return _statementList
	<#>	do
			_compoundStatement <- compoundStatement
			return [_compoundStatement]
	}

suite :: LexemeParser [Statement]
suite =
	do
	{	do
			_statementList <- statementList
			newLine
			return _statementList
	<#>	do
			newLine
			indent
			_statements <- many1 statement
			dedent
			return $ concat _statements
	}
		
fileInput :: LexemeParser [Statement]
fileInput =
	do
		_statements <- 
			many $
				do
				{	do
						newLine
						return []
				<#>	statement
				}
		endOfFile
		return $ concat _statements
